fun sexprToString'(Void) = "#<void>"
  | sexprToString'(Nil) = "()"
  | sexprToString'(Number(n)) = Int.toString(n)
  | sexprToString'(Char(#" ")) = "#\\space"
  | sexprToString'(Char(#"\t")) = "#\\tab"
  | sexprToString'(Char(#"\n")) = "#\\newline"
  | sexprToString'(Char(#"\r")) = "#\\return"
  | sexprToString'(Char(ch)) = 
    if (ch > #" ") then "#\\" ^ Char.toString(ch)
    else let val n = ord(ch)
	     val o3 = n mod 8
	     val tmp = n div 8
	     val o2 = tmp mod 8
	     val o1 = tmp div 8
	 in
	     "#\\" ^
	     Int.toString(o1) ^
	     Int.toString(o2) ^ 
	     Int.toString(o3)
	 end
  | sexprToString'(Bool(true)) = "#t"
  | sexprToString'(Bool(false)) = "#f"
  | sexprToString'(String(str)) = "\"" ^ str ^ "\""
  | sexprToString'(Symbol(name)) = name
  | sexprToString'(Pair(Symbol("quote"),
		   Pair(e, Nil))) = "'" ^ sexprToString'(e)
  | sexprToString'(Pair(car, cdr)) = toStringWithCar(sexprToString'(car), cdr)
  | sexprToString'(Vector(s)) = 
    "#(" ^ (String.concatWith " " (map sexprToString' s)) ^ ")"
and toStringWithCar(car, Nil) = "(" ^ car ^ ")"
  | toStringWithCar(car, Pair(first, second)) = 
    toStringWithCar(car ^ " " ^ sexprToString'(first), second)
  | toStringWithCar(car, e) = "(" ^ car ^ " . " ^ sexprToString'(e) ^ ")"
and sexprToString(Void) = ""
  | sexprToString(e) = sexprToString'(e);

local 
    val bintag = (fn tag => (fn str => "<" ^ tag ^ ">" ^ str ^ "</" ^ tag ^ ">"))
    val ital = bintag "I"
    val bold = bintag "B"
    val sub = bintag "SUB"
    val html = bintag "HTML"
    val head = bintag "HEAD"
    val body = bintag "BODY"
    val bintagAttr = 
	(fn tag => (fn attr => (fn str => "<" ^ tag ^ " " ^ attr ^ ">" ^ str ^ "</" ^ tag ^ ">")))
    val red = bintagAttr "FONT" "COLOR='RED'"
    val blue = bintagAttr "FONT" "COLOR='BLUE'"
    val rec run = 
	(fn (Const(sexpr)) => (sexprToString sexpr)
	  | (Var(v)) => (ital v)
	  | (VarFree(v)) => (ital v) ^
			    (sub "f")
	  | (VarParam(v, mi)) => (ital v) ^
				 (sub ("p" ^ (sub (red (Int.toString mi)))))
	  | (VarBound(v, ma, mi)) => (ital v) ^
				     (sub ("b" ^ (sub ((red (Int.toString ma)) ^ 
						       "," ^ 
						       (red (Int.toString mi))))))
	  | (If(test, dit, (Const(Void)))) => 
	    let val test = run test
		val dit = run dit
	    in
		"(" ^ (bold "if") ^ " " ^ test ^ " " ^ dit ^ ")"
	    end
	  | (If(test, dit, dif)) => 
	    let val test = run test
		val dit = run dit
		val dif = run dif
	    in
		"(" ^ (bold "if") ^ " " ^ test ^ " " ^ dit ^ " " ^ dif ^ ")"
	    end
	  | (Abs(vars, expr)) => 
	    let val vars = String.concatWith " " (map ital vars)
		val expr = run expr
	    in
		"(&lambda; (" ^ vars ^ ") " ^ expr ^ ")"
	    end
	  | (AbsOpt(vars, var, expr)) => 
	    let val vars = String.concatWith " " (map ital vars)
		val var = ital var
		val expr = run expr
	    in
		"(&lambda; (" ^ vars ^ " . " ^ var ^ ") " ^ expr ^ ")"
	    end
	  | (AbsVar(var, expr)) => 
	    let val var = ital var
		val expr = run expr
	    in
		"(&lambda; " ^ var ^ " " ^ expr ^ ")"
	    end
	  | (App(proc, [])) => 
	    let val proc = run proc
	    in
		"(" ^ proc ^ ")"
	    end
	  | (App(proc, args)) => 
	    let val proc = run proc
		val args = String.concatWith " " (map run args)
	    in
		"(" ^ proc ^ " " ^ args ^ ")"
	    end
	  | (AppTP(proc, [])) => 
	    let val proc = run proc
	    in
		(blue "(") ^ proc ^ (blue ")")
	    end
	  | (AppTP(proc, args)) => 
	    let val proc = run proc
		val args = String.concatWith " " (map run args)
	    in
		(blue "(") ^ proc ^ " " ^ args ^ (blue ")")
	    end
	  | (Seq(exprs)) => 
	    let val exprs = String.concatWith " " (map run exprs)
	    in
		"(" ^ exprs ^ ")"
	    end
	  | (Or([])) => "(or)"
	  | (Or(exprs)) => 
	    let val exprs = String.concatWith " " (map run exprs)
	    in
		"(" ^ (bold "or") ^ " " ^ exprs ^ ")"
	    end
	  | (Set(var, expr)) => 
	    let val var = run var
		val expr = run expr
	    in
		"(" ^ (bold "set!") ^ " " ^ var ^ " " ^ expr ^ ")"
	    end
	  | (Def(var, expr)) => 
	    let val var = run var
		val expr = run expr
	    in
		"(" ^ (bold "define") ^ " " ^ var ^ " " ^ expr ^ ")"
	    end
	)
in
fun exprToHTMLString e = 
    html((head "") ^ (body (run e)))
end;
